home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 21
/
Cream of the Crop 21 (Terry Blount) (October 1996).iso
/
os2
/
freetype.zip
/
testtime.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-09-07
|
6KB
|
320 lines
program TrueType_Time;
uses Crt, Dos, TTDisp, TTTypes, TTCalc, TTTables, Raster;
{ $DEFINE DEBUG}
{ $DEFINE VISUAL}
const
Precis = 64;
Precis2 = Precis div 2;
PrecisAux = 1024;
Centre_X : int = 320;
Centre_Y : int = 225;
Profile_Buff_Size = 64000;
var
Font_Buffer : PStorage;
curGlyphContours : PGlyphContours;
num_pts : word;
num_ctr : word;
glyfArray : word;
epts_ctr : PShortArray;
xCoord : PStorage;
yCoord : PStorage;
Flag : PByteArray;
ymin, ymax, xmax, xmin, xsize : longint;
res, resB : int;
resR : real;
resX, resY : real;
LastX, LastY : FixedPoint;
numPoints, numContours : int;
curGlyph : ^TGlyph;
curGlyphContour : PGlyphContour;
Bit : TRasterBlock;
yCur : integer;
ScXMax, ScYMax,
CntX, CntY : Integer;
Rotation : int; (* Angle modulo 1024 *)
Procedure InitRows;
var
i: integer;
P: Pointer;
begin
Bit.rows := 450;
Bit.cols := 80;
Bit.width := 640;
Bit.flow := TTFlowDown;
Bit.size := 80*450;
GetMem( Bit.buffer, Bit.size );
if Bit.buffer = NIL then
begin
Writeln('ERREUR:InitRows:Pas assez de mémoire pour le BitMap');
halt(1);
end;
GetMem( P, Profile_Buff_Size );
if P=nil then
begin
writeln('ERREUR:InitRows:Pas assez de mémoire pour le buffer profils');
Halt(2);
end;
InitRasterizer( Bit, P, Profile_Buff_Size );
FillChar( Bit.Buffer^, Bit.Size, 0 );
end;
Procedure Clear_Buffer;
begin
FillChar( Bit.Buffer^, Bit.Size, 0 );
end;
Procedure ClearData;
var i: integer;
begin
FreeMem( XCoord, SizeOf(FixedPoint)*numPoints );
FreeMem( YCoord, SizeOf(FixedPoint)*numPoints );
FreeMem( Flag, numPoints );
end;
Function LoadTrueTypeChar( idx : integer ) : boolean;
var
off : longint;
x, y : Real;
i, szp : integer;
j : word;
c, ct : byte;
Gl : TGlyph;
EM : Word;
CR, SR : Real;
begin
LoadtrueTypeChar:=FALSE;
if (idx<0) or (idx>=Num_Glyphs) then exit;
CurGlyph := @Glyphs^[idx];
Gl := CurGlyph^;
numPoints := Gl.numberOfPoints;
numContours := Gl.numberOfContours;
curGlyphContours := Gl.Contours;
GetMem( XCoord, SizeOf(Fixed)*numPoints );
GetMem( YCoord, SizeOf(Fixed)*numPoints );
GetMem( Flag, numPoints );
xMin := Gl.xMin;
xMax := Gl.xMax;
yMin := Gl.yMin;
yMax := Gl.yMax;
EM := Font_Header^.UnitsPerEM;
dec( xMax, xMin );
dec( yMax, yMin );
dec ( res );
resR := res/EM/2;
xmax := trunc( xmax*resR+0.5 );
ymax := trunc( ymax*resR+0.5 );
CR := Cos( Rotation*Pi/512 );
SR := Sin( Rotation*Pi/512 );
for j:=0 to numPoints-1 do
begin
x := Gl.Points^[j].x * ( res / EM );
y := Gl.Points^[j].y * ( res / EM );
off := Trunc( Precis*( CR*(x-xmax) + SR*(y-ymax) ) );
XCoord^[j] := Precis*( Centre_X + off div Precis ) + Precis2;
off := Trunc( Precis*( - SR*(x-xmax) + CR*(y-ymax) ) );
YCoord^[j] := Precis*( Centre_Y + off div Precis ) + Precis2;
Flag^[j] := Gl.Points^[j].flag;
end;
inc ( res );
resR := 1/res;
xsize := ( xmax + 7 ) div 8;
LoadTrueTypeChar:=TRUE;
end;
function Get_Time : LongInt;
var
heure,
min,
sec,
cent :
{$IFDEF OS2}
longint;
{$ELSE}
word;
{$ENDIF}
begin
GetTime( heure, min, sec, cent );
Get_Time := 6000*longint(min) + 100*longint(sec) + cent;
end;
function ConvertRaster : boolean;
var
B : Array[0..128] of Integer;
i : integer;
G : TGlyphRecord;
begin
for i := 0 to numContours-1 do
B[i] := CurGlyphContours^[i].Finish;
G.Outlines := numContours;
G.OutStarts := @B;
G.Points := numPoints;
G.XCoord := XCoord;
G.YCoord := YCoord;
G.Flag := Flag;
ConvertRaster := RenderGlyph( G, res, res );
end;
var i: integer;
C : Char;
T : longint;
Filename : String;
Fail : Int;
begin
GetMem ( Font_Buffer, 64000 );
InitBuffer( Font_Buffer^, 64000 );
curGlyphContours:=NIL;
num_pts :=0;
num_ctr :=0;
xCoord :=NIL;
yCoord :=NIL;
Flag :=NIL;
for i:=0 to ParamCount do Writeln(ParamStr(i));
If paramCount<>1 then
begin
Writeln('Usage : ',paramStr(0),' FontName[.TTF]');
Halt(1);
end;
Filename := ParamStr(1);
if Pos('.',FileName)=0 then FileName:=FileName+'.TTF';
if not Open_TrueType_File(Filename ) then
begin
Writeln('Erreur, le fichier ',ParamStr(1),' n''a pu être ouvert');
Halt(1);
end;
res := 450;
resB := (res+7) div 8;
Rotation := 0;
Load_TrueType_Tables;
Load_TrueType_MaxProfile;
if Load_TrueType_Glyphs=0 then
begin
Writeln('Problème lors du chargement des glyphes');
Halt(1);
end;
InitRows;
res := 850;
Fail := 0;
{$IFDEF VISUAL}
SetGraphScreen;
{$ENDIF}
T := Get_Time;
for i:=0 to Num_Glyphs-1 do
begin
if LoadtrueTypeChar(i) then
begin
{$IFDEF VISUAL}
if ConvertRaster then
Display( Bit.Buffer^, 450, 80 )
else
inc(Fail);
Clear_Buffer;
{$ELSE}
if not ConvertRaster then
inc(Fail);
{$ENDIF}
ClearData;
end;
end;
{$IFDEF VISUAL}
RestoreScreen;
{$ENDIF}
Write (' Temps écoulé : ');
T := Get_Time - T;
if T < 0 then T := T + 100*60*60;
writeln('Temps : ', T/100:0:2,' s');
writeln('Echecs: ',Fail );
Close_TrueType_File;
Readkey;
end.